*+--------------------------------------------------------------------
*+
*+
*+
*+    Source Module => /home/paul/click/prb_pop.prg
*+
*+
*+
*+    Click! is a Clipper/Xbase++ source code reformatter.
*+
*+    
*+
*+    Note:Phil is no longer actively developing Click!.
*+
*+    Copyright(C) 1996-1999 by Phil Barnett.
*+
*+       
*+
*+    This program is free software; you can redistribute it and/or modify it
*+
*+    under the terms of the GNU General Public License as published by the
*+
*+    Free Software Foundation; either version 2 of the License, or (at your
*+
*+    option) any later version.
*+
*+    
*+
*+    This program is distributed in the hope that it will be useful, but
*+
*+    WITHOUT ANY WARRANTY; without even the implied warranty of
*+
*+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*+
*+    General Public License for more details.
*+
*+    
*+
*+    You should have received a copy of the GNU General Public License along
*+
*+    with this program; if not, contact the Free Software Foundation, Inc.,
*+
*+    51 Franklin St, Fifth Floor Boston, MA 02110, USA, or www.fsf.org.
*+
*+    
*+
*+    You can contact me at:
*+
*+    
*+
*+    Phil Barnett
*+
*+    Box 944
*+
*+    Plymouth, Florida  32768
*+
*+    
*+
*+    or
*+
*+    
*+
*+    philb@iag.net
*+
*+    
*+
*+    
*+
*+    Ported to Linux and xHarbour compiler, minor feature additions.
*+
*+    Changed version to 3.00xHarbour  Changes
*+
*+    GPL version 3 Copyright (C) 2006-9 by Paul States 
*+
*+    Contact:broadcastmail AT NOSPAM 123mail.org.
*+
*+
*+
*+    Functions: Procedure POP_MSG()
*+               Procedure CLR_MSG()
*+               Procedure ATTENTION()
*+               Procedure CNT()
*+               Function c()
*+               Function Amaxstrlen()
*+               Function VERIFY()
*+               Function ASK_FOR()
*+               Procedure cls()
*+               Function FULLDATE()
*+
*+    Reformatted by Click! 3.00Harbour on Apr-13-2009 at  2:30 pm
*+
*+
*+--------------------------------------------------------------------
*+



#include "common.ch"
#include "box.ch"
#include "set.ch"

static THISSCRN
static TL
static BOXHIGH
static cBox     := ".-.|'-`| "



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure POP_MSG()
*+
*+    Called from ( click.prg    )   9 - procedure click()
*+                ( prb_pop.prg  )   1 - function verify()
*+                                   1 - function ask_for()
*+
*+       Calls    ( prb_pop.prg  )   1 - function amaxstrlen()
*+                ( prb_pop.prg  )   1 - procedure attention()
*+                ( prb_pop.prg  )   1 - procedure cnt()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure POP_MSG(SOME_TXT,MSG_LOGIC,BORDCOLOR,MAINCOLOR)



local MAXLEN
local x
local ARLEN
local INCOLOR
local CROW
local CCOL
local LC

default MSG_LOGIC to .t.

default BORDCOLOR to 'B+/W'
default MAINCOLOR to 'N/W,W+/B'

if !isarray(SOME_TXT)
   SOME_TXT := {SOME_TXT}
endif

ARLEN := len(SOME_TXT)

TL := (maxrow() / 2) - ((ARLEN / 2)+2)

MAXLEN := min(maxcol() - 4,max(Amaxstrlen(SOME_TXT),25)+6)

BOXHIGH  := ARLEN+2
THISSCRN := savescreen(TL - 2,0,BOXHIGH+TL+1,maxcol())
CROW     := row()
CCOL     := col()

LC := int((maxcol() - MAXLEN) / 2)

//dispbox( TL - 1, LC, BOXHIGH + TL, LC + MAXLEN - 1, B_DOUBLE_SINGLE + ' ', BORDCOLOR )
dispbox(TL - 1,LC,BOXHIGH+TL,LC+MAXLEN - 1,cBox,BORDCOLOR)

dispbegin()

INCOLOR := setcolor(MAINCOLOR)

for x := 1 to ARLEN
   CNT(SOME_TXT[x],TL+x)
next

dispend()

if MSG_LOGIC
   ATTENTION('Press any key to continue',BOXHIGH+TL)
   inkey(0)
   restscreen(TL - 2,0,BOXHIGH+TL+1,79,THISSCRN)
   THISSCRN := ''
   devpos(CROW,CCOL)
endif

setcolor(INCOLOR)

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure CLR_MSG()
*+
*+    Called from ( prb_pop.prg  )   1 - function verify()
*+                                   1 - function ask_for()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure CLR_MSG()



restscreen(TL - 2,0,BOXHIGH+TL+1,79,THISSCRN)

THISSCRN := ''

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure ATTENTION()
*+
*+    Called from ( filnpath.prg )   1 - function createini()
*+                                   1 - function createhdr()
*+                ( prb_pop.prg  )   1 - procedure pop_msg()
*+
*+       Calls    ( prb_pop.prg  )   1 - function c()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure ATTENTION(CSTRING,NLINENUM,CCOLOR)



local COLDCOLOR

default NLINENUM to 24
default CCOLOR to 'GR+/R'

COLDCOLOR := setcolor(CCOLOR)

CSTRING := '  '+alltrim(CSTRING)+'  '

devpos(NLINENUM,c(CSTRING))

devout(CSTRING)

setcolor(COLDCOLOR)

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure CNT()
*+
*+    Called from ( prb_pop.prg  )   1 - procedure pop_msg()
*+
*+       Calls    ( prb_pop.prg  )   1 - function c()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure CNT(CSTRING,NLINENUM)



devpos(NLINENUM,c(CSTRING))

devout(CSTRING)

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function c()
*+
*+    Called from ( prb_pop.prg  )   1 - procedure attention()
*+                                   1 - procedure cnt()
*+                                   2 - function ask_for()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function c(CSTRING)



return max((maxcol() / 2) - int(len(CSTRING) / 2),0)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function Amaxstrlen()
*+
*+    Called from ( prb_pop.prg  )   1 - procedure pop_msg()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function Amaxstrlen(ANARRAY)



local ARLEN
local THISLEN
local max     := 0
local x

if isarray(ANARRAY)

   ARLEN := len(ANARRAY)

   for x := 1 to ARLEN
      THISLEN := len(ANARRAY[X])
      if THISLEN > max
         max := THISLEN
      endif
   next

endif

return max



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function VERIFY()
*+
*+    Called from ( click.prg    )   4 - procedure click()
*+
*+       Calls    ( prb_pop.prg  )   1 - procedure clr_msg()
*+                ( prb_pop.prg  )   1 - procedure pop_msg()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function VERIFY(SOME_TXT,LNORMANS,YES_PRMPT,NO_PRMPT,BORDCOLOR,MAINCOLOR)



local INCOLOR
local VERI
local ARLEN
default BORDCOLOR to 'W+/R'
default MAINCOLOR to 'W+/R,W+/B'

LNORMANS  := iif(valtype(LNORMANS) = "L",LNORMANS,.t.)
YES_PRMPT := iif(YES_PRMPT = NIL,' YES ',' '+alltrim(YES_PRMPT)+' ')
NO_PRMPT  := iif(NO_PRMPT = NIL,' NO ',' '+alltrim(NO_PRMPT)+' ')

if !isarray(SOME_TXT)
   SOME_TXT := {SOME_TXT}
endif

ARLEN := len(SOME_TXT)+2

asize(SOME_TXT,ARLEN)

SOME_TXT[ ARLEN - 1 ] := ''
SOME_TXT[ ARLEN ]     := ''

POP_MSG(SOME_TXT,.f.,BORDCOLOR,MAINCOLOR)

VERI := iif(LNORMANS,1,2)

INCOLOR := setcolor(MAINCOLOR)
@ TL - 2+BOXHIGH,33 - (len(YES_PRMPT) / 2) prompt YES_PRMPT
@ TL - 2+BOXHIGH,46 - (len(NO_PRMPT) / 2) prompt NO_PRMPT

menu to VERI

clr_msg()

setcolor(INCOLOR)

return (VERI == 1)



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function ASK_FOR()
*+
*+       Calls    ( prb_pop.prg  )   2 - function c()
*+                ( prb_pop.prg  )   1 - procedure clr_msg()
*+                ( prb_pop.prg  )   1 - procedure pop_msg()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function ASK_FOR(SOME_TXT,Getvar,PICVAR,BORDCOLOR,MAINCOLOR)



local GETLIST := {}

local INCOLOR  := setcolor()
local INCURSOR := set(_SET_CURSOR)
local ARLEN
local VCNT
local RETVAL
local CROW     := row()
local CCOL     := col()

default BORDCOLOR to 'G+/GR'
default MAINCOLOR to 'GR+/GR,W+/B,,,W+/N'

if !isarray(SOME_TXT)
   SOME_TXT := {SOME_TXT}
endif

ARLEN := len(SOME_TXT)+2

asize(SOME_TXT,ARLEN)

do case
case ischaracter(Getvar)
   VCNT := c(Getvar)
case isdate(Getvar)
   VCNT := 35
case isnumber(Getvar)
   VCNT := c(PICVAR)
otherwise
   VCNT := maxcol() / 2
endcase

SOME_TXT[ ARLEN - 1 ] := ''
SOME_TXT[ ARLEN ]     := space(((maxcol() / 2) - VCNT) * 2)

POP_MSG(SOME_TXT,.f.,BORDCOLOR,MAINCOLOR)

setcolor(MAINCOLOR)

if isdate(Getvar)
   @ TL+BOXHIGH - 2,VCNT get Getvar         
else
   @ TL+BOXHIGH - 2,VCNT get Getvar picture PICVAR        
endif

set cursor (.t.)
read
set(_SET_CURSOR,INCURSOR)

clr_msg()

RETVAL := Getvar

if ischaracter(Getvar)
   Getvar := alltrim(Getvar)
endif

setcolor(INCOLOR)
devpos(CROW,CCOL)

return RETVAL



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure cls()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure cls(NEWCOLOR,BKGCHR)



default NEWCOLOR to 'GB+/N,R/W,,,W+/N'
default BKGCHR to 177

setcolor(NEWCOLOR)

//dispbox( 0, 0, maxrow(), maxcol(), replicate( chr( BKGCHR ), 9 ) )
dispbox(0,0,maxrow(),maxcol(),cBox)

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Function FULLDATE()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
function FULLDATE(ANYDATE)



default ANYDATE to date()

return cmonth(ANYDATE)+' '+ltrim(str(day(ANYDATE),2))+', '+str(year(ANYDATE),4)



*+ EOF: prb_pop.prg
*+
